home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
pb3brows.zip
/
VID&KBD.BAS
< prev
Wrap
BASIC Source File
|
1993-04-03
|
5KB
|
164 lines
'******************************************************************************
'* Module met enkele Powerbasic 3 routines *
'* voor video en toetsenbord *
'* (c) Hans Lunsing - 04/1993 *
'******************************************************************************
$DIM ARRAY
$ERROR ALL -
$LIB LPT -, COM -, GRAPH -, FULLFLOAT -, IPRINT -
$OPTIMIZE SIZE
$OPTION CNTLBREAK -, GOSUB -
$STRING 1
DEFINT A-Z
'Absolute adressen:
%AddressOffs = &H44E 'Video current page start address in regen buffer
%AddressPort = &H463 'Video CRT controller base address:
'color=03D4h, mono=03B4h
%ModeSetting = &H465 'Video current setting of mode select register
'03D8h/03B8h
'Videopoorten:
' 3B0 - 3BFh monochrome
' 3C0 - 3CFh EGA (primary)
' 3D0 - 3DFh CGA
%MonoPorts = &H3BF 'highest portnumber for monochrome monitors
%MonoSeg = &HB000
%ColorSeg = &HB800
$INCLUDE "GENERAL.BI"
SUB Attr (BYVAL Fore, BYVAL Back) PUBLIC
COLOR (Fore + 2 * (Back AND 8)), (Back AND 7)
END SUB
FUNCTION BlinkStatus PUBLIC
' Function: returns blinkbit status of textcolor
DEF SEG = &H0
BlinkStatus = ((PEEK(%ModeSetting) AND &H20) = &H20)
DEF SEG
END FUNCTION
SUB ClearLines (BYVAL Top, BYVAL Bottom) PUBLIC
VIEW TEXT (1,Top) - (pbvScrnCols,Bottom)
CLS TEXT
VIEW TEXT (1,1) - (pbvScrnCols,pbvScrnRows)
END SUB
FUNCTION GetActiveColor PUBLIC
' Function: gets active screen color for DOS
REG %DX, &H20
REG %AX, &H200
CALL INTERRUPT &H21 'Put space on screen via DOS
REG %AX, &HF00
CALL INTERRUPT &H10 'Get videopage in BH
REG %AX, &HE08
CALL INTERRUPT &H10 'backspace Whiteh videointerrupt 10
REG %AX, &H800
CALL INTERRUPT &H10 'get attribute at cursor
GetActiveColor = REG(%AX) \ 256
END FUNCTION
SUB GetAttr (Fore, Back) PUBLIC
Fore = (pbvScrnTtxtAttr AND &HF)
Back = (pbvScrnTtxtAttr AND &HF0)
SHIFT RIGHT Back, 4
END SUB
FUNCTION GetKey PUBLIC
DO: LOOP UNTIL INSTAT
GetKey = MakeKey (INKEY$)
END FUNCTION
SUB GetVideoAddress (VideoSeg, VideoOffs) PUBLIC
DEF SEG = 0
IF PEEKI(%AddressPort) = %MonoPorts THEN
VideoSeg = %MonoSeg
ELSE
VideoSeg = %ColorSeg
END IF
VideoOffs = PEEKI(%AddressOffs)
DEF SEG
END SUB
FUNCTION GetVideoMode PUBLIC
'Function: gets active videomode according to BIOS
REG %AX, &HF00
CALL INTERRUPT &H10
GetVideoMode = (REG(%AX) AND &HFF) 'VideoMode in AL
END FUNCTION
SUB InvertColor (BYVAL Fore, BYVAL Back, InverseFore, InverseBack) PUBLIC
'Attributes Whiteh monochrome textmode
'(NORTON's programmers guide to the IBM PC):
'BLINKING ENABLED:
'Normal Betekenis inverse chosen:
'Fore Back Foreground Backgroundgrond Fore Back
' 0 0 Black Black - -
' 1 0 White underlined Black 0 7
' 7 0 White Black 0 7
' 9 0 BrightWhite underld Black 0 7
' 15 0 BrightWhite Black 0 7
' 0 7 Black White 7 0
' 7 8 blinking White Black 1) 0 15
' 15 8 blinking BrhtWhite Black 1) 0 15
' 0 15 blinking Black White 7 8
'BLINKING DISABLED:
'Normal
'Fore Back Foreground Background Fore Back
' 0 0 Black Black - -
' 1 0 White underlined Black 0 7
' 7 0 White Black 0 7
' 9 0 BrghtWhite underld Black 0 15
' 15 0 BrightWhite Black 0 15
' 0 7 Black White 7 0
' 7 8 White grey 1) 0 7
' 15 8 BrightWhite grey 1) 0 15
' 0 15 Black BrightWhite 15 0
' 1) Not on all monochrome monitoren
IF BlinkStatus THEN
IF GetVideoMode = 7 THEN
InverseFore = (Back AND 7)
InverseBack = (InverseFore XOR 7) + (Back AND 8)
ELSE
'Als het hoogste kleurbit de betekenis blinkinge tekst heeft
'worden alleen de laagste drie bits van elke kleur geinverteerd.
'Bit 3 (helderheid voorgrond) en bit 7 (knipperen voorgrond)
'blijven staan.
InverseFore = (Back AND 7) + (Fore AND 8)
InverseBack = (Fore AND 7) + (Back AND 8)
END IF
ELSE
IF GetVideoMode = 7 THEN
InverseFore = (Back AND 7) - ((Back AND 7) <> 0) * (Back AND 8)
InverseBack = ((InverseFore AND 7) XOR 7) + (Fore AND 8)
ELSE
InverseFore = Back
InverseBack = Fore
END IF
END IF
END SUB
FUNCTION MakeChar$ (BYVAL Toets) PUBLIC
IF Toets >= 0 THEN
MakeChar$ = CHR$(Toets)
ELSE
MakeChar$ = CHR$(0) + CHR$(-Toets)
END IF
END FUNCTION
FUNCTION MakeKey (Char$) PUBLIC
IF LEN(Char$) = 1 THEN
MakeKey = ASCII(Char$)
ELSE
MakeKey = - ASCII(RIGHT$(Char$, 1))
END IF
END FUNCTION